home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH6 / SRC / AALIAS2.FRM < prev    next >
Text File  |  1997-01-08  |  12KB  |  445 lines
  1. VERSION 4.00
  2. Begin VB.Form AntiAliasForm 
  3.    Caption         =   "Anti-Aliasing"
  4.    ClientHeight    =   4485
  5.    ClientLeft      =   1905
  6.    ClientTop       =   1275
  7.    ClientWidth     =   5835
  8.    DrawMode        =   14  'Copy Pen
  9.    Height          =   5175
  10.    Left            =   1845
  11.    LinkTopic       =   "Form1"
  12.    ScaleHeight     =   299
  13.    ScaleMode       =   3  'Pixel
  14.    ScaleWidth      =   389
  15.    Top             =   645
  16.    Width           =   5955
  17.    Begin VB.CheckBox ColorCheck 
  18.       Caption         =   "Color"
  19.       Height          =   255
  20.       Left            =   3120
  21.       TabIndex        =   9
  22.       Top             =   45
  23.       Value           =   1  'Checked
  24.       Width           =   735
  25.    End
  26.    Begin VB.CommandButton CmdGo 
  27.       Caption         =   "Go"
  28.       Default         =   -1  'True
  29.       Height          =   375
  30.       Left            =   4080
  31.       TabIndex        =   8
  32.       Top             =   0
  33.       Width           =   615
  34.    End
  35.    Begin VB.TextBox ScaleText 
  36.       Height          =   285
  37.       Left            =   2520
  38.       TabIndex        =   6
  39.       Text            =   "2"
  40.       Top             =   30
  41.       Width           =   375
  42.    End
  43.    Begin VB.PictureBox EnlargedPic 
  44.       AutoRedraw      =   -1  'True
  45.       BackColor       =   &H00C0C0C0&
  46.       ForeColor       =   &H00000000&
  47.       Height          =   3870
  48.       Left            =   1965
  49.       Picture         =   "AALIAS2.frx":0000
  50.       ScaleHeight     =   254
  51.       ScaleMode       =   3  'Pixel
  52.       ScaleWidth      =   254
  53.       TabIndex        =   4
  54.       Top             =   600
  55.       Width           =   3870
  56.    End
  57.    Begin VB.PictureBox AntiAliasedPic 
  58.       AutoRedraw      =   -1  'True
  59.       BackColor       =   &H00C0C0C0&
  60.       ForeColor       =   &H00000000&
  61.       Height          =   1935
  62.       Left            =   0
  63.       Picture         =   "AALIAS2.frx":0446
  64.       ScaleHeight     =   125
  65.       ScaleMode       =   3  'Pixel
  66.       ScaleWidth      =   125
  67.       TabIndex        =   2
  68.       Top             =   2520
  69.       Width           =   1935
  70.    End
  71.    Begin VB.PictureBox AliasedPic 
  72.       AutoRedraw      =   -1  'True
  73.       BackColor       =   &H00C0C0C0&
  74.       BeginProperty Font 
  75.          name            =   "Times New Roman"
  76.          charset         =   0
  77.          weight          =   700
  78.          size            =   15.75
  79.          underline       =   0   'False
  80.          italic          =   -1  'True
  81.          strikethrough   =   0   'False
  82.       EndProperty
  83.       ForeColor       =   &H00000000&
  84.       Height          =   1935
  85.       Left            =   0
  86.       Picture         =   "AALIAS2.frx":088C
  87.       ScaleHeight     =   125
  88.       ScaleMode       =   3  'Pixel
  89.       ScaleWidth      =   125
  90.       TabIndex        =   0
  91.       Top             =   240
  92.       Width           =   1935
  93.    End
  94.    Begin VB.Label Label1 
  95.       Caption         =   "Scale"
  96.       Height          =   255
  97.       Index           =   3
  98.       Left            =   2040
  99.       TabIndex        =   7
  100.       Top             =   45
  101.       Width           =   495
  102.    End
  103.    Begin VB.Label Label1 
  104.       Caption         =   "Enlarged"
  105.       Height          =   255
  106.       Index           =   2
  107.       Left            =   1965
  108.       TabIndex        =   5
  109.       Top             =   360
  110.       Width           =   735
  111.    End
  112.    Begin VB.Label Label1 
  113.       Caption         =   "Anti-Aliased"
  114.       Height          =   255
  115.       Index           =   1
  116.       Left            =   0
  117.       TabIndex        =   3
  118.       Top             =   2280
  119.       Width           =   975
  120.    End
  121.    Begin VB.Label Label1 
  122.       Caption         =   "Aliased"
  123.       Height          =   255
  124.       Index           =   0
  125.       Left            =   0
  126.       TabIndex        =   1
  127.       Top             =   0
  128.       Width           =   615
  129.    End
  130.    Begin VB.Menu mnuFile 
  131.       Caption         =   "&File"
  132.       Begin VB.Menu mnuFileExit 
  133.          Caption         =   "E&xit"
  134.       End
  135.    End
  136. End
  137. Attribute VB_Name = "AntiAliasForm"
  138. Attribute VB_Creatable = False
  139. Attribute VB_Exposed = False
  140. Option Explicit
  141.  
  142. ' ************************************************
  143. ' Redraw the original stuff.
  144. ' ************************************************
  145. Private Sub ColorCheck_Click()
  146.     DrawIt AliasedPic
  147. End Sub
  148.  
  149.  
  150.  
  151. ' ************************************************
  152. ' Anti-alias.
  153. ' ************************************************
  154. Sub CmdGo_Click()
  155. Dim S As Integer
  156.  
  157.     MousePointer = vbHourglass
  158.     
  159.     ' Make EnlargedPic the correct size.
  160.     If Not IsNumeric(ScaleText.Text) Then _
  161.         ScaleText.Text = "2"
  162.     S = CInt(ScaleText.Text)
  163.     If S < 1 Then
  164.         ScaleText.Text = "2"
  165.         S = 2
  166.     End If
  167.     
  168.     EnlargedPic.Width = _
  169.         EnlargedPic.Width - _
  170.         EnlargedPic.ScaleWidth + _
  171.         S * AliasedPic.ScaleWidth + S
  172.     EnlargedPic.Height = _
  173.         EnlargedPic.Height - _
  174.         EnlargedPic.ScaleHeight + _
  175.         S * AliasedPic.ScaleHeight + S
  176.     
  177.     ' Make EnlargedPic use the right thicknesses.
  178.     EnlargedPic.DrawWidth = S * AliasedPic.DrawWidth
  179.     EnlargedPic.Font.Size = S * AliasedPic.Font.Size
  180.     
  181.     ' Draw the enlarged picture.
  182.     AntiAliasedPic.Cls
  183.     DrawIt EnlargedPic
  184.     DoEvents
  185.     
  186.     ' Shrink the enlarged picture.
  187.     ShrinkPicture EnlargedPic, AntiAliasedPic, S
  188.  
  189.     MousePointer = vbDefault
  190. End Sub
  191.  
  192. ' ************************************************
  193. ' Draw some stuff to work with.
  194. ' ************************************************
  195. Sub BWDrawStuff(pic As PictureBox)
  196. Const PI = 3.14159
  197. Const MSG = "Smile!"
  198.  
  199. Dim x1 As Single
  200. Dim x2 As Single
  201. Dim x3 As Single
  202. Dim x4 As Single
  203. Dim x5 As Single
  204. Dim x6 As Single
  205. Dim x7 As Single
  206. Dim y1 As Single
  207. Dim y2 As Single
  208. Dim dy As Single
  209. Dim r1 As Single
  210. Dim r2 As Single
  211. Dim r3 As Single
  212. Dim r4 As Single
  213.  
  214.     x1 = pic.ScaleWidth * 0.4
  215.     x2 = pic.ScaleWidth * 0.27
  216.     x3 = pic.ScaleWidth * 0.53
  217.     x4 = pic.ScaleWidth * 0.29
  218.     x5 = pic.ScaleWidth * 0.55
  219.     x6 = pic.ScaleWidth * 0.8
  220.     x7 = pic.ScaleWidth * 1
  221.     y1 = pic.ScaleHeight * 0.4
  222.     y2 = pic.ScaleHeight * 0.25
  223.     r1 = pic.ScaleHeight * 0.35
  224.     r2 = pic.ScaleHeight * 0.25
  225.     r3 = pic.ScaleHeight * 0.05
  226.     r4 = pic.ScaleHeight * 0.0375
  227.     
  228.     pic.Cls
  229.     
  230.     pic.Circle (x1, y1), r1
  231.     pic.Circle (x1, y1), r2, , PI, 2 * PI
  232.     pic.Circle (x1, y1), r3
  233.     pic.Circle (x2, y2), r3
  234.     pic.Circle (x3, y2), r3
  235.     pic.FillStyle = vbFSSolid
  236.     pic.Circle (x4, y2), r4, , , , 1.5
  237.     pic.Circle (x5, y2), r4, , , , 1.5
  238.     pic.FillStyle = vbFSTransparent
  239.     
  240.     pic.CurrentX = x1 - pic.TextWidth(MSG) / 2
  241.     pic.CurrentY = (pic.ScaleHeight + y1 + r1 _
  242.         - pic.TextHeight(MSG)) / 2
  243.     pic.Print MSG
  244.     
  245.     dy = pic.ScaleHeight / 15
  246.     For y1 = dy / 2 To pic.ScaleHeight Step dy
  247.         pic.Line (x6, y1)-(x7, y1 * 2)
  248.     Next y1
  249. End Sub
  250.  
  251. ' ************************************************
  252. ' Draw stuff in color or black and white.
  253. ' ************************************************
  254. Sub DrawIt(pic As PictureBox)
  255.     If ColorCheck.Value = vbChecked Then
  256.         ColorDrawStuff pic
  257.     Else
  258.         BWDrawStuff pic
  259.     End If
  260. End Sub
  261.  
  262.  
  263. ' ************************************************
  264. ' Draw some stuff to work with.
  265. ' ************************************************
  266. Sub ColorDrawStuff(pic As PictureBox)
  267. Const PI = 3.14159
  268. Const MSG = "Smile!"
  269.  
  270. Dim x1 As Single
  271. Dim x2 As Single
  272. Dim x3 As Single
  273. Dim x4 As Single
  274. Dim x5 As Single
  275. Dim x6 As Single
  276. Dim x7 As Single
  277. Dim y1 As Single
  278. Dim y2 As Single
  279. Dim dy As Single
  280. Dim r1 As Single
  281. Dim r2 As Single
  282. Dim r3 As Single
  283. Dim r4 As Single
  284.  
  285.     x1 = pic.ScaleWidth * 0.4
  286.     x2 = pic.ScaleWidth * 0.27
  287.     x3 = pic.ScaleWidth * 0.53
  288.     x4 = pic.ScaleWidth * 0.29
  289.     x5 = pic.ScaleWidth * 0.55
  290.     x6 = pic.ScaleWidth * 0.8
  291.     x7 = pic.ScaleWidth * 1
  292.     y1 = pic.ScaleHeight * 0.4
  293.     y2 = pic.ScaleHeight * 0.25
  294.     r1 = pic.ScaleHeight * 0.35
  295.     r2 = pic.ScaleHeight * 0.25
  296.     r3 = pic.ScaleHeight * 0.05
  297.     r4 = pic.ScaleHeight * 0.0375
  298.     
  299.     pic.Cls
  300.     
  301.     pic.FillStyle = vbFSSolid
  302.     pic.FillColor = vbYellow
  303.     pic.ForeColor = pic.FillColor
  304.     pic.Circle (x1, y1), r1
  305.     pic.FillColor = RGB(255, 153, 51)
  306.     pic.ForeColor = pic.FillColor
  307.     pic.Circle (x1, y1), r3
  308.     pic.FillColor = vbWhite
  309.     pic.ForeColor = vbBlack
  310.     pic.Circle (x2, y2), r3
  311.     pic.Circle (x3, y2), r3
  312.     pic.FillColor = vbBlack
  313.     pic.Circle (x4, y2), r4, , , , 1.5
  314.     pic.Circle (x5, y2), r4, , , , 1.5
  315.     pic.FillStyle = vbFSTransparent
  316.     pic.ForeColor = vbRed
  317.     pic.Circle (x1, y1), r2, , PI, 2 * PI
  318.     
  319.     pic.ForeColor = vbBlue
  320.     pic.CurrentX = x1 - pic.TextWidth(MSG) / 2
  321.     pic.CurrentY = (pic.ScaleHeight + y1 + r1 _
  322.         - pic.TextHeight(MSG)) / 2
  323.     pic.Print MSG
  324.     
  325.     pic.ForeColor = RGB(&H80, 0, &H80)
  326.     dy = pic.ScaleHeight / 15
  327.     For y1 = dy / 2 To pic.ScaleHeight Step dy
  328.         pic.Line (x6, y1)-(x7, y1 * 2)
  329.     Next y1
  330.  
  331.     pic.ForeColor = vbBlack
  332. End Sub
  333.  
  334.  
  335.  
  336. ' ************************************************
  337. ' Shrink fpic into tpic, reducing by a factor of
  338. ' 1/s.
  339. ' ************************************************
  340. Sub ShrinkPicture(fpic As PictureBox, tpic As PictureBox, S As Integer)
  341. Dim SysPal(0 To 255) As PALETTEENTRY
  342. Dim x As Integer
  343. Dim y As Integer
  344. Dim i As Integer
  345. Dim j As Integer
  346. Dim r As Long
  347. Dim g As Long
  348. Dim b As Long
  349. Dim status As Long
  350. Dim bm As BITMAP
  351. Dim hbm As Integer
  352. Dim wid As Long
  353. Dim hgt As Long
  354. Dim fbytes() As Byte
  355. Dim tbytes() As Byte
  356. Dim pos As Integer
  357.  
  358.     ' Make sure fpic has the foreground palette.
  359.     fpic.ZOrder
  360.     status = RealizePalette(fpic.hdc)
  361.     DoEvents
  362.  
  363.     ' Get the system palette entries.
  364.     status = GetSystemPaletteEntries(fpic.hdc, 0, 256, SysPal(0))
  365.         
  366.     ' Get the input pixels.
  367.     hbm = fpic.Image
  368.     status = GetObject(hbm, BITMAP_SIZE, bm)
  369.     wid = bm.bmWidthBytes
  370.     hgt = bm.bmHeight
  371.     ReDim fbytes(0 To wid - 1, 0 To hgt - 1)
  372.     status = GetBitmapBits(hbm, wid * hgt, fbytes(0, 0))
  373.  
  374.     ' Dimension the output pixel array.
  375.     hbm = tpic.Image
  376.     status = GetObject(hbm, BITMAP_SIZE, bm)
  377.     wid = bm.bmWidthBytes
  378.     hgt = bm.bmHeight
  379.     ReDim tbytes(0 To wid - 1, 0 To hgt - 1)
  380.  
  381.     ' Shrink the image.
  382.     For y = 0 To hgt - 1
  383.         For x = 0 To wid - 1
  384.             ' Compute the value of pixel (x, y).
  385.             r = 0
  386.             g = 0
  387.             b = 0
  388.             For i = 0 To S - 1
  389.                 For j = 0 To S - 1
  390.                     pos = fbytes(S * x + j, S * y + i)
  391.                     r = r + SysPal(pos).peRed
  392.                     g = g + SysPal(pos).peGreen
  393.                     b = b + SysPal(pos).peBlue
  394.                 Next j
  395.             Next i
  396.             ' Set the output pixel's value.
  397.             r = r / S / S
  398.             g = g / S / S
  399.             b = b / S / S
  400.             tpic.PSet (x, y), RGB(r, g, b)
  401.         Next x
  402.         DoEvents
  403.     Next y
  404. End Sub
  405. Private Sub Form_Load()
  406.     ' Make sure the screen supports palettes.
  407.     If Not GetDeviceCaps(hdc, RASTERCAPS) And RC_PALETTE Then
  408.         Beep
  409.         MsgBox "This monitor does not support palettes.", _
  410.             vbCritical
  411.         End
  412.     End If
  413.     
  414.     ' Make everyone use the same font.
  415.     AntiAliasedPic.Font.Name = AliasedPic.Font.Name
  416.     AntiAliasedPic.Font.Bold = AliasedPic.Font.Bold
  417.     AntiAliasedPic.Font.Italic = AliasedPic.Font.Italic
  418.     AntiAliasedPic.Font.Strikethrough = AliasedPic.Font.Strikethrough
  419.     AntiAliasedPic.Font.Underline = AliasedPic.Font.Underline
  420.  
  421.     EnlargedPic.Font.Name = AliasedPic.Font.Name
  422.     EnlargedPic.Font.Bold = AliasedPic.Font.Bold
  423.     EnlargedPic.Font.Italic = AliasedPic.Font.Italic
  424.     EnlargedPic.Font.Strikethrough = AliasedPic.Font.Strikethrough
  425.     EnlargedPic.Font.Underline = AliasedPic.Font.Underline
  426.         
  427.     ' Make AntiAliasedPic use the right thicknesses.
  428.     AntiAliasedPic.DrawWidth = AliasedPic.DrawWidth
  429.     AntiAliasedPic.Font.Size = AliasedPic.Font.Size
  430.         
  431.     ' Draw original stuff.
  432.     DrawIt AliasedPic
  433. End Sub
  434.  
  435. Private Sub Form_Unload(Cancel As Integer)
  436.     End
  437. End Sub
  438.  
  439.  
  440. Private Sub mnuFileExit_Click()
  441.     Unload Me
  442. End Sub
  443.  
  444.  
  445.